home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / multi-1a / frmmain.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-08-27  |  4.5 KB  |  164 lines
  1. VERSION 5.00
  2. Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
  3. Begin VB.Form frmMain 
  4.    Caption         =   "Chat - Server"
  5.    ClientHeight    =   2820
  6.    ClientLeft      =   60
  7.    ClientTop       =   630
  8.    ClientWidth     =   6645
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   188
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   443
  13.    StartUpPosition =   2  'CenterScreen
  14.    Begin VB.TextBox txtInput 
  15.       BackColor       =   &H00E0E0E0&
  16.       Height          =   285
  17.       Left            =   120
  18.       TabIndex        =   0
  19.       Top             =   2400
  20.       Width           =   6375
  21.    End
  22.    Begin VB.TextBox txtOutput 
  23.       BackColor       =   &H00E0E0E0&
  24.       Enabled         =   0   'False
  25.       Height          =   2175
  26.       Left            =   120
  27.       Locked          =   -1  'True
  28.       MultiLine       =   -1  'True
  29.       TabIndex        =   1
  30.       Top             =   120
  31.       Width           =   6375
  32.    End
  33.    Begin MSWinsockLib.Winsock sckServer 
  34.       Index           =   0
  35.       Left            =   480
  36.       Top             =   0
  37.       _ExtentX        =   741
  38.       _ExtentY        =   741
  39.       _Version        =   393216
  40.    End
  41.    Begin MSWinsockLib.Winsock sckListening 
  42.       Left            =   0
  43.       Top             =   0
  44.       _ExtentX        =   741
  45.       _ExtentY        =   741
  46.       _Version        =   393216
  47.    End
  48.    Begin VB.Menu File 
  49.       Caption         =   "&File"
  50.       Begin VB.Menu line 
  51.          Caption         =   "-"
  52.       End
  53.       Begin VB.Menu Exit 
  54.          Caption         =   "E&xit"
  55.       End
  56.    End
  57.    Begin VB.Menu Options 
  58.       Caption         =   "&Options"
  59.       Begin VB.Menu KickUser 
  60.          Caption         =   "K&ick User"
  61.       End
  62.    End
  63. Attribute VB_Name = "frmMain"
  64. Attribute VB_GlobalNameSpace = False
  65. Attribute VB_Creatable = False
  66. Attribute VB_PredeclaredId = True
  67. Attribute VB_Exposed = False
  68. Private Sub Exit_Click()
  69. End Sub
  70. Private Sub Form_Load()
  71. For x = 1 To 49
  72. Load sckServer(x)
  73. User(x).FreeSocket = True
  74. Next x
  75. User(0).FreeSocket = True
  76. sckListening.LocalPort = 1000
  77. sckListening.Listen
  78. Me.Caption = "Server - " & sckListening.LocalIP
  79. End Sub
  80. Private Sub Form_Resize()
  81. On Error Resume Next
  82. txtInput.Top = frmMain.ScaleHeight - 30
  83. txtInput.Width = frmMain.ScaleWidth - 16
  84. txtOutput.Width = frmMain.ScaleWidth - 16
  85. txtOutput.Height = frmMain.ScaleHeight - 45
  86. txtOutput.Left = 8
  87. txtInput.Left = 8
  88. End Sub
  89. Private Sub Form_Terminate()
  90. On Error Resume Next
  91. For x = 1 To 49
  92. Unload sckServer(x)
  93. Next x
  94. End Sub
  95. Private Sub Form_Unload(Cancel As Integer)
  96. On Error Resume Next
  97. For x = 1 To 49
  98. Unload sckServer(x)
  99. Next x
  100. End Sub
  101. Private Sub KickUser_Click()
  102. Dim Output As String
  103. Output = InputBox("Who would you like to kick?", "Who:")
  104. For x = 0 To 49
  105. If User(x).FreeSocket = False Then
  106. If LCase(Output) = LCase(User(x).Name) Then
  107. Output = InputBox("For what reason are you kicking?", "Reason:")
  108. sckServer(x).SendData "Kicked" & vbTab & Output & vbCrLf
  109. DoEvents
  110. Exit Sub
  111. End If
  112. End If
  113. Next x
  114. MsgBox "No one in the chat has that name!", vbInformation, "Note:"
  115. End Sub
  116. Private Sub sckListening_ConnectionRequest(ByVal requestID As Long)
  117. For x = 0 To 49
  118. If User(x).FreeSocket = True Then
  119. User(x).FreeSocket = False
  120. sckServer(x).Accept requestID
  121. Exit For
  122. End If
  123. Next x
  124. End Sub
  125. Private Sub sckServer_Close(Index As Integer)
  126. User(Index).FreeSocket = True
  127. SendMessage User(Index).Name & " has left the chat!"
  128. User(Index).Name = ""
  129. sckServer(Index).Close
  130. End Sub
  131. Private Sub Text(Text As String)
  132. txtOutput.SelStart = Len(txtOutput.Text)
  133. txtOutput.SelText = Text & vbCrLf
  134. End Sub
  135. Private Sub sckServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
  136. Dim Data As String, MainData() As String, SplitData() As String
  137. sckServer(Index).GetData Data, vbString
  138. MainData = Split(Data, vbCrLf)
  139. For x = LBound(MainData) To UBound(MainData) - 1
  140. SplitData = Split(MainData(x), vbTab)
  141. Select Case SplitData(0)
  142. Case "Message"
  143. SendMessage SplitData(1)
  144. Case "Name"
  145. User(Index).Name = SplitData(1)
  146. SendMessage User(Index).Name & " has joined the chat!"
  147. End Select
  148. Next x
  149. End Sub
  150. Private Sub txtInput_KeyDown(KeyCode As Integer, Shift As Integer)
  151. Select Case KeyCode
  152. Case vbKeyReturn
  153. SendMessage "Server Message: " & txtInput.Text
  154. txtInput.Text = ""
  155. End Select
  156. End Sub
  157. Private Sub SendMessage(Message As String)
  158. Text Message
  159. For x = 0 To 49
  160. If User(x).FreeSocket = False Then sckServer(x).SendData "Message" & vbTab & Message & vbCrLf
  161. DoEvents
  162. Next x
  163. End Sub
  164.